Chip 2001 December/Chip Aralık 2001.iso/prog/office/f_0259/Common.xba

Extensible Markup Language | 2001-07-30 | 7.8 KB | 259 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Common" script:language="StarBasic"> REM  *****  BASIC  *****
Public DialogModel as Object
Public DialogConvert as Object
Public DialogPassword as Object
Public PasswordModel as Object

Sub    RetrieveDocumentObjects()
    CurMimeType = oDocument.DocumentInfo.MimeType
    If Instr(1, CurMimeType, "calc") <> 0 Then
        oSheets = oDocument.Sheets
        oSheet = oDocument.Sheets.GetbyIndex(0)
'        oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
    End If
    oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator
    ' Retrieve the indices for the cellformatations
    oFormats = oDocument.NumberFormats
End Sub


Sub CloseDialog
Dim n, m as Integer
    If Not bMacroStopped Then
        bMacroStopped = True
        DialogConvert.EndExecute
        If Not DocDisposed Then
            ReprotectSheets()
        End If
        Stop
    End If
End Sub


Function ConvertDocument()
    GoOn = True
    DocDisposed = True
    InitializeProgressbar()
    If Instr(1, CurMimeType, "calc") <> 0 Then
        bDocHasProtectedSheets = CheckSheetProtection(oSheets)
        If bDocHasProtectedSheets Then
            bDocHasProtectedSheets = UnprotectSheetsWithPassword(oSheets, bDoUnProtect)
        End If
        If Not bDocHasProtectedSheets Then
            If Not bRangeListDefined Then
                TotCellCount = 0
                CreateRangeEnumeration(True)
            Else
                IncreaseStatusvalue(SBRelGet/3)
            End If
            RangeIndex = Ubound(RangeList(), 1)
            If RangeIndex > -1 Then
                ConvertThehardWay(RangeList(), True, False)
                MakeStyleEnumeration(True)
                oDocument.calculateAll()
            End If
            ReprotectSheets()
            bRangeListDefined = False
        End If
    Else
        oStatusline.SetValue(10)
        ConvertTextFields()
        oStatusline.SetValue(80)
        ConvertWriterTables()
    End If
    oStatusline.End
    On Local Error Goto 0
End Function


Sub SwitchNumberFormat(oObject as Object, oFormats as object, sNewSymbol as String)
Dim nFormatLanguage as Integer
Dim nFormatDecimals as Integer
Dim nFormatLeading as Integer
Dim bFormatLeading as Integer
Dim bFormatNegRed as Integer
Dim bFormatThousands as Integer
Dim aLocLocale As New com.sun.star.lang.Locale
Dim i as Integer
Dim aNewStr as String
Dim iNumberFormat as Long
Dim AddToList as Boolean

    ' Numberformat mit dem neuen Symbol als Basis f├╝r generateFormat
    aSimpleStr = "0 [$"+sNewSymbol+"]"
    nSimpleKey = Numberformat(oFormats, aSimpleStr, oLocale)
    On Local Error Resume Next
    iNumberFormat = oObject.NumberFormat
    If Err <> 0 Then
        Msgbox "Error Reading the Number Format"
        Resume CLERROR
    End If

    On Local Error GoTo NOKEY
    aFormat() = oFormats.getByKey(iNumberFormat)
    On Local Error GoTo 0
    ' Typ und Währungssymbol des Numberformats heraussuchen
    ' neues Währungsformat mit passenden Einstellungen setzen
    nFormatDecimals = aFormat.Decimals
    nFormatLeading = aFormat.LeadingZeros
    bFormatNegRed = aFormat.NegativeRed
    bFormatThousands = aFormat.ThousandsSeparator
    aLocLocale = aFormat.Locale
    aNewStr = oFormats.generateFormat( nSimpleKey, oLocale, _
            bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)

    oObject.NumberFormat = Numberformat(oFormats, aNewStr, aLocLocale)
    NOKEY:
    If Err <> 0 Then
        Resume CLERROR
    End If
    CLERROR:
End Sub


Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Object)
Dim nRetkey
    nRetKey = oFormats.queryKey( aFormatStr, oLocale, True )
    If nRetKey = -1 Then
        nRetKey = oFormats.addNew( aFormatStr, oLocale )
        If nRetKey = -1 Then nRetKey = 0
    End If
    Numberformat = nRetKey
End Function


' Funktion findet den Formattyp einer Vorlage, Zelle oder eines Bereiches heraus und schreibt das Ergebnis
' in die globale Variable nFormatType; Ist ein Währungssymbol gesetzt, wird dieses in den globalen String
' sFormatCurrency geschrieben.
Function CheckFormatType( FormatObject as object)
Dim i as Integer
Dim LocCurrIndex as Integer
Dim nFormatFormatString as String
Dim FormatLangID as Integer
Dim sFormatCurrExt as String
Dim oFormatofObject() as Object

    ' Retrieve the Format of the Object
    On Local Error GoTo NOKEY
    oFormatofObject = oFormats.getByKey(FormatObject.NumberFormat)
    On Local Error GoTo 0
    ' Typ und Währungssymbol des Numberformats heraussuchen
      If NOT INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY Then
        CheckFormatType = False
        Exit Function
    End If

    If FieldinArray(CurrSymbolList(),2,oFormatofObject.CurrencySymbol) Then
        ' If the Currencysymbol of the object ist the one needed, then check the Currency extension
        sFormatCurrExt = oFormatofObject.CurrencyExtension

        If FieldInList(CurExtension(),1,sFormatCurrExt) Then
            ' The Currency - extension also fits
            CheckFormatType = True
        Else
            ' The Currency - symbol is Euro-conforming (like 'DEM'), so there is no Currency-Extension
            CheckFormatType = oFormatofObject.CurrencySymbol = CurrsymbolList(2)
        End If
    Else
        ' The Currency Symbol of the object is not the desired one
        If oFormatofObject.CurrencySymbol = "" Then
            ' Format is "automatic"
            CheckFormatType = CheckLocale(oFormatofObject.Locale)
        Else
            CheckFormatType = False
        End If
    End If

    NOKEY:
    If Err <> 0 Then
        CheckFormatType = False
        Resume CLERROR
    End If
    CLERROR:
End Function


Sub StartConversion()
    GoOn = True
'    ToggleWindow(False)
    Select Case DialogModel.Step
        Case 1
            If DialogModel.chkComplete.State = 1 Then
                ConvertWholeDocument()
            Else
                ConvertRangesorStylesofDocument()
            End If
        Case 2
            InitializeThirdStep()
            ConvertDocuments()
        Case 3
            CloseDialog()

    End Select
End Sub


Sub IncreaseStatusValue(AddStatusValue as Integer)
    StatusValue = Int(StatusValue + AddStatusValue)
    oStatusline.SetValue(StatusValue)
End Sub


Sub SelectCurrency()
Dim AddtoList as Boolean
Dim UpRangeList as Integer
Dim OldCurrIndex as Integer
    OldCurrIndex = CurrIndex
    CurrIndex = DialogModel.lstCurrencies.SelectedItems(0)
    InitializeCurrencyValues(CurrIndex)
    CurExtension(0) = LangIDValue(CurrIndex,0,2)
    CurExtension(1) = LangIDValue(CurrIndex,1,2)
    If DialogModel.Step = 1 Then
        If OldCurrIndex = -1 Then
            DialogModel.chkComplete.State = 1
            EnableStep1DialogControls(True,False, True)
            SetOptionValuestoNull()
        Else
            EnableStep1DialogControls(False,False, False)
            If DialogModel.optCellTemplates.State = 1 Then
                EnableStep1DialogControls(False, False, False)
                CreateStyleEnumeration()
                EnableStep1DialogControls(True, True, True)
            ElseIf ((DialogModel.optSheetRanges.State = 1) OR (DialogModel.optDocRanges.State = 1)) AND (DialogModel.Step = 1) Then
                UpRangeList = UBound(RangeList())
                ReDim RangeList(UpRangeList) 'as String
                CreateRangeEnumeration(False)
            ElseIf DialogModel.optSelRange.State= 1 Then
                'Preselected Range
                CheckRangeSelection()
            End If
            EnableStep1DialogControls(True, True, True)
        End If
    ElseIf DialogModel.Step = 2 Then
        EnableStep2DialogControls(True)
    End If
End Sub


Sub FillUpCurrencyListbox()
Dim i as Integer
Dim MaxIndex as Integer
    MaxIndex = Ubound(CurrValue(),1)
    Dim LocList(MaxIndex) as String
    For i = 0 To MaxIndex
        LocList(i) = CurrValue(i,0)
    Next i
    DialogModel.lstCurrencies.StringItemList() = LocList()
    If CurrIndex > -1 Then
        SelectListboxItem(DialogModel.lstCurrencies, CurrIndex)
    End If
End Sub


Sub InitializeProgressbar()
    CurCellCount = 0
    oStatusline.Start(sStsPROGRESS,100)             '"Konvertierungsfortschritt:"
    StatusValue = 0
End Sub</script:module>